开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
VrBitmapsDlg.pas
资源名称：varian_led_studio_3.34.rar　[点击查看]
上传用户：hbszzs
上传日期：2008-08-20
资源大小：628k
文件大小：5k
源码类别：

Delphi控件源码

开发平台：

Delphi

VrBitmapsDlg.pas：源码内容
  1. {*****************************************************}
  2. {                                                     }
  3. {     Varian Component Workshop                       }
  4. {                                                     }
  5. {     Varian Software NL (c) 1996-2000                }
  6. {     All Rights Reserved                             }
  7. {                                                     }
  8. {*****************************************************}
  10. unit VrBitmapsDlg;
  12. interface
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  16.   VrClasses, Buttons, StdCtrls, ExtCtrls, ExtDlgs, VrControls, VrButtons,
  17.   VrDeskTop;
  19. type
  20.   TVrBitmapListDialog = class(TForm)
  21.     Panel1: TPanel;
  22.     ListBox: TListBox;
  23.     SaveDialog: TSaveDialog;
  24.     OpenDialog: TOpenDialog;
  25.     OpenPictureDialog: TOpenPictureDialog;
  26.     VrShadowButton1: TVrShadowButton;
  27.     VrShadowButton2: TVrShadowButton;
  28.     VrShadowButton3: TVrShadowButton;
  29.     VrShadowButton4: TVrShadowButton;
  30.     VrShadowButton5: TVrShadowButton;
  31.     VrShadowButton6: TVrShadowButton;
  32.     VrShadowButton7: TVrShadowButton;
  33.     VrShadowButton8: TVrShadowButton;
  34.     VrShadowButton9: TVrShadowButton;
  35.     VrDeskTop1: TVrDeskTop;
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure FormDestroy(Sender: TObject);
  38.     procedure ButtonAddClick(Sender: TObject);
  39.     procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
  40.       Rect: TRect; State: TOwnerDrawState);
  41.     procedure ButtonDeleteClick(Sender: TObject);
  42.     procedure ButtonClearClick(Sender: TObject);
  43.     procedure ButtonLoadClick(Sender: TObject);
  44.     procedure ButtonSaveClick(Sender: TObject);
  45.     procedure ButtonMoveUpClick(Sender: TObject);
  46.     procedure ButtonMoveDownClick(Sender: TObject);
  47.     procedure SpeedButton1Click(Sender: TObject);
  48.     procedure VrShadowButton9Click(Sender: TObject);
  49.   private
  50.     procedure BitmapsChanged(Sender: TObject);
  51.   public
  52.     Bitmaps: TVrBitmaps;
  53.   end;
  56. implementation
  58. {$R *.DFM}
  61. procedure TVrBitmapListDialog.FormCreate(Sender: TObject);
  62. begin
  63.   Bitmaps := TVrBitmaps.Create;
  64.   Bitmaps.OnChange := BitmapsChanged;
  65. end;
  67. procedure TVrBitmapListDialog.FormDestroy(Sender: TObject);
  68. begin
  69.   Bitmaps.Free;
  70. end;
  72. procedure TVrBitmapListDialog.ButtonAddClick(Sender: TObject);
  73. var
  74.   Bitmap: TBitmap;
  75. begin
  76.   if OpenPictureDialog.Execute then
  77.   begin
  78.     Bitmap := TBitmap.Create;
  79.     try
  80.       Bitmap.LoadFromFile(OpenPictureDialog.FileName);
  81.       Bitmaps.Add(Bitmap);
  82.     finally
  83.       Bitmap.Free;
  84.     end;
  85.   end;
  86. end;
  88. procedure TVrBitmapListDialog.ListBoxDrawItem(Control: TWinControl; Index: Integer;
  89.   Rect: TRect; State: TOwnerDrawState);
  90. var
  91.   ImgRect: TRect;
  92.   MidY: Integer;
  93.   S: string;
  94. begin
  95.   with TListBox(Control) do
  96.   begin
  97.     Canvas.FillRect(Rect);
  98.     ImgRect := Rect;
  99.     ImgRect.Right := 62;
  100.     OffsetRect(ImgRect, 2, 0);
  101.     InflateRect(ImgRect, 0, -2);
  102.     Canvas.StretchDraw(ImgRect, Bitmaps[Index]);
  103.     S := Format('%d - %d x %d', [Index, Bitmaps[Index].Width, Bitmaps[Index].Height]);
  104.     MidY := ((Rect.Bottom - Rect.Top) - Canvas.TextHeight(S)) div 2;
  105.     Canvas.TextOut(ImgRect.Right + 20, Rect.Top + MidY, S);
  106.   end;
  107. end;
  109. procedure TVrBitmapListDialog.ButtonDeleteClick(Sender: TObject);
  110. var
  111.   Index: Integer;
  112. begin
  113.   Index := ListBox.ItemIndex;
  114.   if Index <> -1 then
  115.     Bitmaps.Delete(Index);
  116. end;
  118. procedure TVrBitmapListDialog.ButtonClearClick(Sender: TObject);
  119. begin
  120.   if MessageDlg('Clear list?', mtConfirmation,
  121.     [mbOk, mbCancel], 0) = mrOk then Bitmaps.Clear;
  122. end;
  124. procedure TVrBitmapListDialog.ButtonLoadClick(Sender: TObject);
  125. begin
  126.   if OpenDialog.Execute then
  127.     Bitmaps.LoadFromFile(OpenDialog.FileName);
  128. end;
  130. procedure TVrBitmapListDialog.ButtonSaveClick(Sender: TObject);
  131. begin
  132.   if SaveDialog.Execute then
  133.     Bitmaps.SaveToFile(SaveDialog.FileName);
  134. end;
  136. procedure TVrBitmapListDialog.ButtonMoveUpClick(Sender: TObject);
  137. var
  138.   Index: Integer;
  139. begin
  140.   Index := ListBox.ItemIndex;
  141.   if Index - 1 >= 0 then
  142.   begin
  143.     Bitmaps.Move(Index, Index - 1);
  144.     ListBox.ItemIndex := Index - 1;
  145.   end;
  146. end;
  148. procedure TVrBitmapListDialog.ButtonMoveDownClick(Sender: TObject);
  149. var
  150.   Index: Integer;
  151. begin
  152.   Index := ListBox.ItemIndex;
  153.   if (Index <> -1) and (Index + 1 < ListBox.Items.Count) then
  154.   begin
  155.     Bitmaps.Move(Index, Index + 1);
  156.     ListBox.ItemIndex := Index + 1;
  157.   end;
  158. end;
  160. procedure TVrBitmapListDialog.SpeedButton1Click(Sender: TObject);
  161. begin
  162.   ModalResult := mrOk;
  163. end;
  165. procedure TVrBitmapListDialog.BitmapsChanged(Sender: TObject);
  166. var
  167.   I: Integer;
  168. begin
  169.   ListBox.Items.BeginUpdate;
  170.   try
  171.     ListBox.Items.Clear;
  172.     for I := 0 to Bitmaps.Count - 1 do
  173.       ListBox.Items.Add('XXX');
  174.   finally
  175.     ListBox.Items.EndUpdate;
  176.   end;
  177. end;
  179. procedure TVrBitmapListDialog.VrShadowButton9Click(Sender: TObject);
  180. begin
  181.   ModalResult := mrCancel;
  182. end;
  184. end.