Рисование графики

         Изображение на форме текста под разными углами

         Вывод JPEG картинки на форму

         Изменение разрешения экрана

         Создание меню с правой стороны окна


Изображение на форме текста под разными углами

procedure CanvasSetAngle(C: TCanvas; A: Single);
var LogRec: TLOGFONT; {Font informationen}
begin
  GetObject(C.Font.Handle,SizeOf(LogRec),Addr(LogRec));
  LogRec.lfEscapement := Trunc(A*10);
  C.Font.Handle := CreateFontIndirect(LogRec);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
             Shift: TShiftState; X, Y: Integer);
var A: Integer;
begin
  A := Random(3600);
  Canvas.Font.Name:='Arial';
  CanvasSetAngle(Canvas, A / 10);
  Canvas.RectAngle(X-1,Y-1,X+1,Y+1);
  Canvas.TextOut(x, Y, FormatFloat('##0.0', A/10)+'ё');
end;

Вывод JPEG картинки на форму

uses JPeg;

  ...
  Image1: TImage;
  ...

procedure TForm1.Button1Click(Sender: TObject);
var jp:TJpegImage;
begin
  jp:=TJpegImage.Create;
  jp.LoadFromFile('d:\picture.jpg');
  Form1.Image1.Height:=jp.Height;
  Form1.Image1.Width:=jp.Width;
  Form1.Image1.Picture.Assign(jp);
  jp.Free;
end;

Изменение разрешения экрана

function SetFullscreenMode(ModeIndex: Integer):boolean;
var DeviceMode : TDevMode;
begin
  with DeviceMode do begin
    dmSize:=SizeOf(DeviceMode);
    dmBitsPerPel:=16;
    dmPelsWidth:=640;
    dmPelsHeight:=480;
    dmFields:=DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
    Result:=False;
    if ChangeDisplaySettings(DeviceMode,CDS_TEST or CDS_FULLSCREEN) 
                <> DISP_CHANGE_SUCCESSFUL then
      Exit;
    Result:=ChangeDisplaySettings(DeviceMode,CDS_FULLSCREEN) 
            = DISP_CHANGE_SUCCESSFUL;
  end;
end;

procedure RestoreDefaultMode;
var T : TDevMode absolute 0;
begin
  ChangeDisplaySettings(T,CDS_FULLSCREEN);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if setFullScreenMode(1) then begin
    sleep(7000);
    RestoreDefaultMode;
  end;
end;

Создание меню с правой стороны окна

  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    HelpItem1: TMenuItem;
    Help1: TMenuItem;
    File: TMenuItem;
    Save: TMenuItem;
    ....

procedure TForm1.FormCreate(Sender: TObject);
begin
  ModifyMenu(MainMenu1.Handle, 0, mf_ByPosition or 
          mf_Popup or mf_Help,HelpItem1.Handle, Pchar(HelpItem1.caption));
end;

main_back.gif (3425 bytes)

Используются технологии uCoz